Metadata from IPBES on Zenodo

Back to the Repository

Setup and get records from Zenodo

#|

# Load the zen4R library
library(zen4R)
library(openalexR)

Thank you for using openalexR!
To acknowledge our work, please cite the package by calling `citation("openalexR")`.
To suppress this message, add `openalexR.message = suppressed` to your .Renviron file.

library(dplyr)

Attaching package: 'dplyr'

The following objects are masked from 'package:stats':

    filter, lag

The following objects are masked from 'package:base':

    intersect, setdiff, setequal, union

fn <- file.path("data", "ipbes_zenodo_records")
if (!file.exists(paste0(fn, ".rds"))) {
    # Authenticate with Zenodo
    zen <- ZenodoManager$new(token = Sys.getenv("Zenodo_IPBES_RO"))

    # Get the community ID
    community_id <- "ipbes"

    # Get the community info
    community <- zen$getCommunityById(community_id)

    # Get all deposits with ipbes somwhere
    ipbes_zenodo <- zen$getRecords(community_id)

    # Filter records based on the community ID
    ipbes <- sapply(
        ipbes_zenodo,
        function(record) {
            "ipbes" %in% unlist(record$metadata$communities)
        }
    )

    ipbes_zenodo <- ipbes_zenodo[ipbes]

    rm(ipbes)

    saveRDS(ipbes_zenodo, paste0(fn, ".rds"))
} else {
    ipbes_zenodo <- readRDS(paste0(fn, ".rds"))
}

Get the dois and titles of the records

dois <- data.frame()

for (i in seq(length.out = length(ipbes_zenodo))) {
    record <- ipbes_zenodo[[i]]
    dois <- rbind(
        dois,
        c(
            doi = record$metadata$doi,
            year = record$metadata$publication_date,
            title = record$metadata$title
        )
    )
}

names(dois) <- c("doi", "year", "title")

dois <- tibble::as_tibble(dois)

#|
fn <- file.path(".", "data", "ipbes_works.rds")
if (!file.exists(fn)) {
    # Define the maximum chunk size
    chunk_size <- 50
    # Split the vector into chunks
    doi_chunks <- split(
        dois$doi,
        ceiling(seq_along(dois$doi) / chunk_size)
    )

    ipbes_works <- lapply(
        doi_chunks,
        function(dois) {
            openalexR::oa_query(doi = dois) |>
                openalexR::oa_request(count_only = FALSE)
        }
    ) |>
        unlist(recursive = FALSE)

    saveRDS(ipbes_works, file = fn)
} else {
    ipbes_works <- readRDS(file = fn)
}

IPBES deposits on Zenodo with OpenAlex ids

This is a quick and dirty table - it could made nicer - but it fulfills it’s purpose.

ipbes_works |>
    openalexR::works2df() |>
    dplyr::select(
        # year = publication_year,
        # title,
        doi,
        oa_id = id
    ) |>
    dplyr::mutate(
        doi = gsub(pattern = "https://doi.org/", replacement = "", x = doi)
    ) |>
    dplyr::left_join(
        x = dois,
        by = c("doi" = "doi")
    ) |>
    dplyr::mutate(
        doi = paste0("<a href='https://doi.org/", doi, "' target='_blank'>", doi, "</a>"),
        oa_id = ifelse(
            is.na(oa_id),
            "",
            paste0("<a href='", oa_id, "' target='_blank'>", gsub(pattern = "https://openalex.org/", replacement = "", oa_id), "</a>")
        )
    ) |>
    select(
        doi,
        oa_id,
        year,
        title
    ) |>
    IPBES.R::table_dt()

IPBES Deposits Network

fn <- file.path("data", "ipbes_network.rds")

if (!file.exists(fn)) {
    relations <- lapply(
        ipbes_zenodo,
        function(rec) {
            relation <- rec$metadata$related_identifiers
            if (is.null(relation)) {
                return(NULL)
            }
            result <- rec$metadata$related_identifiers |>
                dplyr::bind_rows() |>
                dplyr::mutate(
                    year = rec$metadata$publication_date,
                    doi = rec$metadata$doi,
                    title = rec$metadata$title,
                    keywords = rec$metadata$keywords |> 
                        unlist() |> 
                        paste(collapse = "; "),
                    
                )
            return(result)
        }
    ) |>
        dplyr::bind_rows() |>
        dplyr::left_join(
            y = read.table("inst/relation_direction.txt", header = TRUE),
            by = "relation"
        )

    nodes <- unique(
        c(
            relations$doi,
            relations$identifier
        )
    )

    edges <- rbind(
        relations |>
            filter(
                direction == "to"
            ) |>
            dplyr::select(
                from = doi,
                to = identifier
            ),
        relations |>
            filter(
                direction == "from"
            ) |>
            dplyr::select(
                from = doi,
                to = identifier
            )
    )

    network <- list(
        nodes = nodes,
        edges = edges
    )

    ipbes_network <- list(
        nodes = nodes,
        edges = edges,
        relations = relations
    )
    rm(nodes, edges, relations)

    saveRDS(ipbes_network, fn)
} else {
    ipbes_network <- readRDS(fn)
}

fn <- file.path("figures", "ipbes_network.html")

## Simple forceNetwork
networkData <- data.frame(
    src = ipbes_network$edges$from,
    target = ipbes_network$edges$to,
    stringsAsFactors = FALSE
)

nodes <- data.frame(
    name = ipbes_network$nodes,
    # title = ipbes_network$nodes$,
    # doi = ipbes_network$nodes$doi,
    stringsAsFactors = FALSE
)

nodes$id <- 0:(nrow(nodes) - 1)

# create a data frame of the edges that uses id 0:9 instead of their names
edges <- networkData |>
    left_join(nodes, by = c("src" = "name")) |>
    select(-src) |>
    rename(source = id) |>
    left_join(nodes, by = c("target" = "name")) |>
    select(-target) |>
    rename(target = id) |>
    mutate(width = 1)

# # make a grouping variable that will match to colours
nodes$group <- 1

# nodes$oa_id <- nodes$name
# nodes$name <- nodes$author

# control colours with a JS ordinal scale
# ColourScale <- 'd3.scaleOrdinal()
#                         .domain(["key_paper", "other"])
#                      .range(["#FF6900", "#694489"]);'

openDOI <- "window.open(d.doi)"

nwg <- networkD3::forceNetwork(
    Links = edges,
    Nodes = nodes,
    Source = "source",
    Target = "target",
    NodeID = "name",
    # Nodesize = "nodesize",
    Group = "group",
    # Value = "width",
    opacity = 0.9,
    zoom = TRUE,
    # colourScale = DT::JS(ColourScale),
    fontSize = 20,
    legend = TRUE,
    clickAction = openDOI
)

nwg$x$nodes$doi <- nodes$doi

networkD3::saveNetwork(
    nwg,
    file = fn,
    selfcontained = TRUE
)

unlink(
    gsub(
        fn,
        pattern = "\\.html",
        replacement = "_files"
    ), 
    recursive = TRUE, 
    force = TRUE
)


nwg

IPBES Deposits Network

ipbes_network$relations |>
    dplyr::select(
        year,
        doi,
        relation,
        identifier,
        direction,
        title,
        keywords
    ) |>
    IPBES.R::table_dt(
        fixedColumns = list(leftColumns = 6)
    )